home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / egg / egg-sj3.el.z / egg-sj3.el
Encoding:
Text File  |  1998-05-21  |  46.0 KB  |  1,407 lines
  1. ;; Kana Kanji Conversion Protocol Package for Egg
  2. ;; Coded by K.Ishii, Sony Corp. (kiyoji@sm.sony.co.jp)
  3.  
  4. ;; This file is part of Egg on Mule (Multilingal Environment)
  5.  
  6. ;; Egg is distributed in the forms of patches to GNU
  7. ;; Emacs under the terms of the GNU EMACS GENERAL PUBLIC
  8. ;; LICENSE which is distributed along with GNU Emacs by the
  9. ;; Free Software Foundation.
  10.  
  11. ;; Egg is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied
  13. ;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  14. ;; PURPOSE.  See the GNU EMACS GENERAL PUBLIC LICENSE for
  15. ;; more details.
  16.  
  17. ;; You should have received a copy of the GNU EMACS GENERAL
  18. ;; PUBLIC LICENSE along with Nemacs; see the file COPYING.
  19. ;; If not, write to the Free Software Foundation, 675 Mass
  20. ;; Ave, Cambridge, MA 02139, USA.
  21.  
  22.  
  23. ;;;
  24. ;;; sj3-egg.el 
  25. ;;;
  26. ;;; $B!V$?$^$4!W$N(B sj3 $B%P!<%8%g%s(B
  27. ;;; $B$+$J4A;zJQ49%5!<%P$K(B sj3serv $B$r;H$$$^$9!#(B
  28. ;;;
  29. ;;; sj3-egg $B$K4X$9$kDs0F!"Cn>pJs$O(B kiyoji@sm.sony.co.jp $B$K$*Aw$j2<$5$$!#(B
  30. ;;;
  31. ;;;                                                $B@P0f(B $B@6<!(B
  32.  
  33. (require 'egg)
  34. (provide 'egg-sj3)
  35. (when (not (boundp 'SJ3))
  36.   (require 'egg-sj3-client))
  37.  
  38. ;;;;  $B=$@5%a%b!(!((B
  39. ;;;; Jul-20-93 by age@softlab.is.tsukuba.ac.jp (Eiji FURUKAWA)
  40. ;;;;  Bug fixed in diced-add, *sj3-bunpo-menu* and
  41. ;;;;  set-egg-henkan-mode-format.
  42.  
  43. ;;;; Mar-19-93 by K.Ishii
  44. ;;;;  DicEd is changed, edit-dict-item -> edit-dict
  45.  
  46. ;;;; Aug-6-92 by K.Ishii
  47. ;;;;  length $B$r(B string-width $B$KJQ99(B
  48.  
  49. ;;;; Jul-30-92 by K.Ishii
  50. ;;;;  set-default-usr-dic-directory $B$G:n$k<-=q%G%#%l%/%H%jL>$N=$@5(B
  51. ;;;;  jserver-host-name, $B4D6-JQ?t(B JSERVER $B$N:o=|(B
  52. ;;;;  
  53.  
  54. ;;;; Jul-7-92 by Y.Kawabe
  55. ;;;;  jserver-host-name $B$r%;%C%H$9$k:]$K4D6-JQ?t(B SJ3SERV $B$bD4$Y$k!#(B
  56. ;;;;  sj3fns.el $B$N%m!<%I$r$d$a$k!#(B
  57.  
  58. ;;;; Jun-2-92 by K.Ishii
  59. ;;;;  sj3-egg.el $B$r(B wnn-egg.el $B$HF1MM$KJ,3d(B
  60.  
  61. ;;;; May-14-92 by K.Ishii
  62. ;;;;  Mule $B$N(B wnn-egg.el $B$r(B sj3serv $B$H$NDL?.MQ$K=$@5(B
  63.  
  64. ;;;----------------------------------------------------------------------
  65. ;;;
  66. ;;; Version control routine
  67. ;;;
  68. ;;;----------------------------------------------------------------------
  69.  
  70. (defvar sj3-egg-version "3.00" "Version number of this version of Egg. ")
  71. ;;; Last modified date: Thu Aug  4 21:18:11 1994
  72.  
  73. ;;;----------------------------------------------------------------------
  74. ;;;
  75. ;;; KKCP package: Kana Kanji Conversion Protocol
  76. ;;;
  77. ;;; KKCP to SJ3SERV interface; 
  78. ;;;
  79. ;;;----------------------------------------------------------------------
  80.  
  81. (defvar *KKCP:error-flag* t)
  82.  
  83. (defun KKCP:error (errorCode &rest form)
  84.   (cond((eq errorCode ':SJ3_SOCK_OPEN_FAIL)
  85.     (notify "EGG: %s $B>e$K(B SJ3SERV $B$,$"$j$^$;$s!#(B" (or (get-sj3-host-name) "local"))
  86.     (if debug-on-error
  87.         (error "EGG: No SJ3SERV on %s is running." (or (get-sj3-host-name) "local"))
  88.       (error  "EGG: %s $B>e$K(B SJ3SERV $B$,$"$j$^$;$s!#(B" (or (get-sj3-host-name) "local"))))
  89.        ((eq errorCode ':SJ3_SERVER_DEAD)
  90.     (notify "EGG: %s $B>e$N(BSJ3SERV $B$,;`$s$G$$$^$9!#(B" (or (get-sj3-host-name) "local"))
  91.     (if debug-on-error
  92.         (error "EGG: SJ3SERV on %s is dead." (or (get-sj3-host-name) "local"))
  93.       (error  "EGG: %s $B>e$N(B SJ3SERV $B$,;`$s$G$$$^$9!#(B" (or (get-sj3-host-name) "local"))))
  94.        ((and (consp errorCode)
  95.          (eq (car errorCode) ':SJ3_UNKNOWN_HOST))
  96.     (notify "EGG: $B%[%9%H(B %s $B$,$_$D$+$j$^$;$s!#(B" (car(cdr errorCode)))
  97.     (if debug-on-error
  98.         (error "EGG: Host %s is unknown." (car(cdr errorCode)))
  99.       (error "EGG: $B%[%9%H(B %s $B$,$_$D$+$j$^$;$s!#(B" (car(cdr errorCode)))))
  100.        ((and (consp errorCode)
  101.          (eq (car errorCode) ':SJ3_UNKNOWN_SERVICE))
  102.     (notify "EGG: Network service %s $B$,$_$D$+$j$^$;$s!#(B" (car(cdr errorCode)))
  103.     (if debug-on-error
  104.         (error "EGG: Service %s is unknown." (car(cdr errorCode)))
  105.       (error "EGG: Network service %s $B$,$_$D$+$j$^$;$s!#(B" (cdr errorCode))))
  106.        (t
  107.     (notify "KKCP: $B860x(B %s $B$G(B %s $B$K<:GT$7$^$7$?!#(B" errorCode form)
  108.     (if debug-on-error
  109.         (error "KKCP: %s failed because of %s." form errorCode)
  110.       (error  "KKCP: $B860x(B %s $B$G(B %s $B$K<:GT$7$^$7$?!#(B" errorCode form)))))
  111.  
  112. (defun KKCP:server-open (hostname loginname)
  113.   (let ((result (sj3-server-open hostname loginname)))
  114.     (cond((null sj3-error-code) result)
  115.      (t (KKCP:error sj3-error-code 'KKCP:server-open hostname loginname)))))
  116.  
  117. (defun KKCP:use-dict (dict &optional passwd)
  118.   (let ((result (sj3-server-open-dict dict passwd)))
  119.     (cond((null sj3-error-code) result)
  120.      ((eq sj3-error-code ':sj3-no-connection)
  121.       (EGG:open-sj3)
  122.       (KKCP:use-dict dict passwd))
  123.      ((null *KKCP:error-flag*) result)
  124.      (t (KKCP:error sj3-error-code 
  125.             'kkcp:use-dict dict)))))
  126.  
  127. (defun KKCP:make-dict (dict)
  128.   (let ((result (sj3-server-make-dict dict)))
  129.     (cond((null sj3-error-code) result)
  130.      ((eq sj3-error-code ':sj3-no-connection)
  131.       (EGG:open-sj3)
  132.       (KKCP:make-dict dict))
  133.      ((null *KKCP:error-flag*) result)
  134.      (t (KKCP:error sj3-error-code 
  135.             'kkcp:make-dict dict)))))
  136.  
  137. (defun KKCP:use-stdy (stdy)
  138.   (let ((result (sj3-server-open-stdy stdy)))
  139.     (cond((null sj3-error-code) result)
  140.      ((eq sj3-error-code ':sj3-no-connection)
  141.       (EGG:open-sj3)
  142.       (KKCP:use-stdy stdy))
  143.      ((null *KKCP:error-flag*) result)
  144.      (t (KKCP:error sj3-error-code 
  145.             'kkcp:use-stdy stdy)))))
  146.  
  147. (defun KKCP:make-stdy (stdy)
  148.   (let ((result (sj3-server-make-stdy stdy)))
  149.     (cond((null sj3-error-code) result)
  150.      ((eq sj3-error-code ':sj3-no-connection)
  151.       (EGG:open-sj3)
  152.       (KKCP:make-stdy stdy))
  153.      ((null *KKCP:error-flag*) result)
  154.      (t (KKCP:error sj3-error-code 
  155.             'kkcp:make-stdy stdy)))))
  156.  
  157. (defun KKCP:henkan-begin (henkan-string)
  158.   (let ((result (sj3-server-henkan-begin henkan-string)))
  159.     (cond((null sj3-error-code) result)
  160.      ((eq sj3-error-code ':sj3-no-connection)
  161.       (EGG:open-sj3)
  162.       (KKCP:henkan-begin henkan-string))
  163.      ((null *KKCP:error-flag*) result)
  164.      (t (KKCP:error sj3-error-code 'KKCP:henkan-begin henkan-string)))))
  165.  
  166. (defun KKCP:henkan-next (bunsetu-no)
  167.   (let ((result (sj3-server-henkan-next bunsetu-no)))
  168.     (cond ((null sj3-error-code) result)
  169.       ((eq sj3-error-code ':sj3-no-connection)
  170.        (EGG:open-sj3)
  171.        (KKCP:henkan-next bunsetu-no))
  172.       ((null *KKCP:error-flag*) result)
  173.       (t (KKCP:error sj3-error-code 'KKCP:henkan-next bunsetu-no)))))
  174.  
  175. (defun KKCP:henkan-kakutei (bunsetu-no jikouho-no)
  176.   ;;; NOTE: $B<!8uJd%j%9%H$,@_Dj$5$l$F$$$k$3$H$r3NG'$7$F;HMQ$9$k$3$H!#(B
  177.   (let ((result (sj3-server-henkan-kakutei bunsetu-no jikouho-no)))
  178.     (cond ((null sj3-error-code) result)
  179.       ((eq sj3-error-code ':sj3-no-connection)
  180.        (EGG:open-sj3)
  181.        (KKCP:henkan-kakutei bunsetu-no jikouho-no))
  182.       ((null *KKCP:error-flag*) result)
  183.       (t (KKCP:error sj3-error-code 'KKCP:henkan-kakutei bunsetu-no jikouho-no)))))
  184.  
  185. (defun KKCP:bunsetu-henkou (bunsetu-no bunsetu-length)
  186.   (let ((result (sj3-server-bunsetu-henkou bunsetu-no bunsetu-length)))
  187.     (cond ((null sj3-error-code) result)
  188.       ((eq sj3-error-code ':sj3-no-connection)
  189.        (EGG:open-sj3)
  190.        (KKCP:bunsetu-henkou bunsetu-no bunsetu-length))
  191.       ((null *KKCP:error-flag*) result)
  192.       (t (KKCP:error sj3-error-code 'kkcp:bunsetu-henkou bunsetu-no bunsetu-length)))))
  193.  
  194.  
  195. (defun KKCP:henkan-quit ()
  196.   (let ((result (sj3-server-henkan-quit)))
  197.     (cond ((null sj3-error-code) result)
  198.       ((eq sj3-error-code ':sj3-no-connection)
  199.        (EGG:open-sj3)
  200.        (KKCP:henkan-quit))
  201.       ((null *KKCP:error-flag*) result)
  202.       (t (KKCP:error sj3-error-code 'KKCP:henkan-quit)))))
  203.  
  204. (defun KKCP:henkan-end (&optional bunsetuno)
  205.   (let ((result (sj3-server-henkan-end bunsetuno)))
  206.     (cond ((null sj3-error-code) result)
  207.       ((eq sj3-error-code ':sj3-no-connection)
  208.        (EGG:open-sj3)
  209.        (KKCP:henkan-end bunsetuno))      
  210.       ((null *KKCP:error-flag*) result)
  211.       (t (KKCP:error sj3-error-code 'KKCP:henkan-end)))))
  212.  
  213. (defun KKCP:dict-add (dictno kanji yomi bunpo)
  214.   (let ((result (sj3-server-dict-add dictno kanji yomi bunpo)))
  215.     (cond ((null sj3-error-code) result)
  216.       ((eq sj3-error-code ':sj3-no-connection)
  217.        (EGG:open-sj3)
  218.        (KKCP:dict-add dictno kanji yomi bunpo))
  219.       ((null *KKCP:error-flag*) result)
  220.       (t (KKCP:error sj3-error-code 'KKCP:dict-add dictno kanji yomi bunpo)))))
  221.  
  222. (defun KKCP:dict-delete (dictno kanji yomi bunpo)
  223.   (let ((result (sj3-server-dict-delete dictno kanji yomi bunpo)))
  224.     (cond ((null sj3-error-code) result)
  225.       ((eq sj3-error-code ':sj3-no-connection)
  226.        (EGG:open-sj3)
  227.        (KKCP:dict-delete dictno kanji yomi bunpo))
  228.       ((null *KKCP:error-flag*) result)
  229.       (t (KKCP:error sj3-error-code 'KKCP:dict-delete dictno kanji yomi bunpo)))))
  230.  
  231. (defun KKCP:dict-info (dictno)
  232.   (let ((result (sj3-server-dict-info dictno)))
  233.     (cond ((null sj3-error-code) result)
  234.       ((eq sj3-error-code ':sj3-no-connection)
  235.        (EGG:open-sj3)
  236.        (KKCP:dict-info dictno))
  237.       ((null *KKCP:error-flag*) result)
  238.       (t (KKCP:error sj3-error-code 'KKCP:dict-info dictno)))))
  239.  
  240. (defun KKCP:make-directory (pathname)
  241.   (let ((result (sj3-server-make-directory pathname)))
  242.     (cond ((null sj3-error-code) result)
  243.       ((eq sj3-error-code ':sj3-no-connection)
  244.        (EGG:open-sj3)
  245.        (KKCP:make-directory pathname))
  246.       ((null *KKCP:error-flag*) result)
  247.       (t (KKCP:error sj3-error-code 'kkcp:make-directory pathname)))))
  248.  
  249. (defun KKCP:file-access (pathname mode)
  250.   (let ((result (sj3-server-file-access pathname mode)))
  251.     (cond ((null sj3-error-code)
  252.        (if (= result 0) t nil))
  253.       ((eq sj3-error-code ':sj3-no-connection)
  254.        (EGG:open-sj3)
  255.        (KKCP:file-access pathname mode))
  256.       ((null *KKCP:error-flag*) result)
  257.       (t (KKCP:error sj3-error-code 'kkcp:file-access pathname mode)))))
  258.  
  259. (defun KKCP:server-close ()
  260.   (let ((result (sj3-server-close)))
  261.     (cond ((null sj3-error-code) result)
  262.       ((null *KKCP:error-flag*) result)
  263.       (t (KKCP:error sj3-error-code 'KKCP:server-close)))))
  264.  
  265. ;;;----------------------------------------------------------------------
  266. ;;;
  267. ;;; Kana Kanji Henkan 
  268. ;;;
  269. ;;;----------------------------------------------------------------------
  270.  
  271. ;;;
  272. ;;; Entry functions for egg-startup-file
  273. ;;;
  274.  
  275. (defvar *default-sys-dic-directory* (if (file-directory-p "/usr/sony/dict")
  276.                     "/usr/sony/dict/sj3"
  277.                       "/usr/local/lib/sj3/dict"))
  278.  
  279. (defun set-default-sys-dic-directory (pathname)
  280.   "$B%7%9%F%`<-=q$NI8=`(Bdirectory PATHNAME$B$r;XDj$9$k!#(B
  281. PATHNAME$B$O4D6-JQ?t$r4^$s$G$h$$!#(B"
  282.  
  283.   (setq pathname (substitute-in-file-name pathname))
  284.  
  285.   (if (file-name-absolute-p pathname)
  286.       (if (null (KKCP:file-access pathname 0))
  287.       (error
  288.        (format "System Default directory(%s) $B$,$"$j$^$;$s!#(B" pathname))
  289.     (setq *default-sys-dic-directory* (file-name-as-directory pathname)))
  290.     (error "Default directory must be absolute pathname")))
  291.  
  292. (defvar *default-usr-dic-directory*
  293.   (if (file-directory-p "/usr/sony/dict/sj3/user")
  294.       "/usr/sony/dict/sj3/user/$USER"
  295.     "/usr/local/lib/sj3/dict/user/$USER"))
  296.  
  297. (defun set-default-usr-dic-directory (pathname)
  298.   "$BMxMQ<T<-=q$NI8=`(Bdirectory PATHNAME$B$r;XDj$9$k!#(B
  299. PATHNAME$B$O4D6-JQ?t$r4^$s$G$h$$!#(B"
  300.  
  301.   (setq pathname (file-name-as-directory (substitute-in-file-name pathname)))
  302.  
  303.   (if (file-name-absolute-p pathname)
  304.       (if (null (KKCP:file-access pathname 0))
  305.       (let ((updir (file-name-directory (substring pathname 0 -1))))
  306.         (if (null (KKCP:file-access updir 0))
  307.         (error
  308.          (format "User Default directory(%s) $B$,$"$j$^$;$s!#(B" pathname))
  309.           (when
  310.           (yes-or-no-p
  311.            (format "User Default directory(%s) $B$r:n$j$^$9$+!)(B"
  312.                pathname))
  313.         (KKCP:make-directory (directory-file-name pathname))
  314.         (notify "User Default directory(%s) $B$r:n$j$^$7$?!#(B"
  315.             pathname))))
  316.     (setq *default-usr-dic-directory* pathname))
  317.     (error "Default directory must be absolute pathname")))
  318.  
  319. (defun setsysdic (dict)
  320.   (egg:setsysdict (expand-file-name
  321.            (concat (if (file-name-absolute-p dict)
  322.                    ""
  323.                  *default-sys-dic-directory*)
  324.                dict))))
  325.  
  326. (defun setusrdic (dict)
  327.   (egg:setusrdict (expand-file-name
  328.            (concat (if (file-name-absolute-p dict)
  329.                    ""
  330.                  *default-usr-dic-directory*)
  331.                dict))))
  332.  
  333. (defvar egg:*dict-list* nil)
  334.  
  335. (defun setusrstdy (stdy)
  336.   (egg:setusrstdy (expand-file-name
  337.            (concat (if (file-name-absolute-p stdy)
  338.                    ""
  339.                  *default-usr-dic-directory*)
  340.                stdy))))
  341.  
  342. (defun egg:setsysdict (dict)
  343.   (cond((assoc (file-name-nondirectory dict) egg:*dict-list*)
  344.     (beep)
  345.     (notify "$B4{$KF1L>$N%7%9%F%`<-=q(B %s $B$,EPO?$5$l$F$$$^$9!#(B"
  346.         (file-name-nondirectory dict))
  347.     )
  348.        ((null (KKCP:file-access dict 0))
  349.     (beep)
  350.     (notify "$B%7%9%F%`<-=q(B %s $B$,$"$j$^$;$s!#(B" dict))
  351.        (t(let* ((*KKCP:error-flag* nil)
  352.         (rc (KKCP:use-dict dict)))
  353.        (if (null rc)
  354.            (error "EGG: setsysdict failed. :%s" dict)
  355.            (setq egg:*dict-list*
  356.              (cons (cons (file-name-nondirectory dict) dict)
  357.                egg:*dict-list*)))))))
  358.  
  359. ;;; dict-no --> dict-name
  360. (defvar egg:*usr-dict* nil)
  361.  
  362. ;;; dict-name --> dict-no
  363. (defvar egg:*dict-menu* nil)
  364.  
  365. (defmacro push-end (val loc)
  366.   (list 'push-end-internal val (list 'quote loc)))
  367.  
  368. (defun push-end-internal (val loc)
  369.   (set loc
  370.        (if (eval loc)
  371.        (nconc (eval loc) (cons val nil))
  372.      (cons val nil))))
  373.  
  374. (defun egg:setusrdict (dict)
  375.   (cond((assoc (file-name-nondirectory dict) egg:*dict-list*)
  376.     (beep)
  377.     (notify "$B4{$KF1L>$NMxMQ<T<-=q(B %s $B$,EPO?$5$l$F$$$^$9!#(B"
  378.         (file-name-nondirectory dict))
  379.     )
  380.        ((null (KKCP:file-access dict 0))
  381.     (notify "$BMxMQ<T<-=q(B %s $B$,$"$j$^$;$s!#(B" dict)
  382.     (if (yes-or-no-p (format "$BMxMQ<T<-=q(B %s $B$r:n$j$^$9$+!)(B" dict))
  383.         (let ((*KKCP:error-flag* nil))
  384.           (if (KKCP:make-dict dict)
  385.           (progn
  386.             (notify "$BMxMQ<T<-=q(B %s $B$r:n$j$^$7$?!#(B" dict)
  387.             (let* ((*KKCP:error-flag* nil)
  388.                (dict-no (KKCP:use-dict dict "")))
  389.               (cond((numberp dict-no)
  390.                 (setq egg:*usr-dict* 
  391.                   (cons (cons dict-no dict) egg:*usr-dict*))
  392.                 (push-end (cons (file-name-nondirectory dict)
  393.                         dict-no) egg:*dict-menu*))
  394.                (t (error "EGG: setusrdict failed. :%s" dict)))))
  395.         (error "EGG: setusrdict failed. : %s" dict)))))
  396.        (t (let* ((*KKCP:error-flag* nil)
  397.          (dict-no (KKCP:use-dict dict "")))
  398.         (cond((numberp dict-no)
  399.           (setq egg:*usr-dict* (cons(cons dict-no dict) 
  400.                         egg:*usr-dict*))
  401.           (push-end (cons (file-name-nondirectory dict) dict-no)
  402.                 egg:*dict-menu*)
  403.           (setq egg:*dict-list*
  404.             (cons (cons (file-name-nondirectory dict) dict)
  405.                   egg:*dict-list*)))
  406.          (t (error "EGG: setusrdict failed. : %s" dict)))))))
  407.  
  408. (defun egg:setusrstdy (stdy)
  409.   (cond((null (KKCP:file-access stdy 0))
  410.     (notify "$B3X=,%U%!%$%k(B %s $B$,$"$j$^$;$s!#(B" stdy)
  411.     (if (yes-or-no-p (format "$B3X=,%U%!%$%k(B %s $B$r:n$j$^$9$+!)(B" stdy))
  412.         (if (null (KKCP:make-stdy stdy))
  413.         (error "EGG: setusrstdy failed. : %s" stdy)
  414.           (notify "$B3X=,%U%!%$%k(B %s $B$r:n$j$^$7$?!#(B" stdy)
  415.           (if (null (KKCP:use-stdy stdy))
  416.           (error "EGG: setusrstdy failed. : %s" stdy))
  417.           )))
  418.     (t (if (null (KKCP:use-stdy stdy))
  419.            (error "EGG: setusrstdy failed. : %s" stdy)))))
  420.  
  421.  
  422. ;;;
  423. ;;; SJ3 interface
  424. ;;;
  425.  
  426. (defun get-sj3-host-name ()
  427.   (cond((and (boundp 'sj3-host-name) (stringp sj3-host-name))
  428.     sj3-host-name)
  429.        ((and (boundp 'sj3serv-host-name) (stringp sj3serv-host-name))
  430.     sj3serv-host-name)
  431.        (t(getenv "SJ3SERV"))))                ; 92.7.7 by Y.Kawabe
  432.  
  433. (fset 'get-sj3serv-host-name (symbol-function 'get-sj3-host-name))
  434.  
  435. (defun set-sj3-host-name (name)
  436.   (interactive "sHost name: ")
  437.   (let (*KKCP:error-flag*)
  438.     (disconnect-sj3))
  439.   (setq sj3-host-name name)
  440.   )
  441.  
  442. (defvar egg-default-startup-file "eggrc"
  443.   "*Egg startup file name (system default)")
  444.  
  445. (defvar egg-startup-file ".eggrc"
  446.   "*Egg startup file name.")
  447.  
  448. (defvar egg-startup-file-search-path (append '("~" ".") load-path)
  449.   "*List of directories to search for start up file to load.")
  450.  
  451. (defun egg:search-file (filename searchpath)
  452.   (let (result)
  453.     (if (null (file-name-directory filename))
  454.     (let ((path searchpath))
  455.       (while (and path (null result ))
  456.         (let ((file (substitute-in-file-name
  457.              (expand-file-name filename (if (stringp (car path)) (car path) nil)))))
  458.           (if (file-exists-p file) (setq result file)
  459.         (setq path (cdr path))))))
  460.       (let((file (substitute-in-file-name (expand-file-name filename))))
  461.     (if (file-exists-p file) (setq result file))))
  462.     result))
  463.  
  464. (defun EGG:open-sj3 ()
  465.   (KKCP:server-open (or (get-sj3-host-name) (system-name))
  466.               (user-login-name))
  467.   (setq egg:*usr-dict* nil
  468.     egg:*dict-list* nil
  469.     egg:*dict-menu* nil)
  470.   (notify "$B%[%9%H(B %s $B$N(B SJ3 $B$r5/F0$7$^$7$?!#(B" (or (get-sj3-host-name) "local"))
  471.   (let ((eggrc (or (egg:search-file egg-startup-file egg-startup-file-search-path)
  472.            (egg:search-file egg-default-startup-file load-path))))
  473.     (if eggrc (load-file eggrc)
  474.       (progn
  475.     (KKCP:server-close)
  476.     (error
  477.      "egg-startup-file-search-path $B>e$K(B egg-startup-file $B$,$"$j$^$;$s!#(B"
  478.      )))))
  479.  
  480. (defun disconnect-sj3 ()
  481.   (interactive)
  482.   (KKCP:server-close))
  483.  
  484. (defun close-sj3 ()
  485.   (interactive)
  486.   (KKCP:server-close))
  487.  
  488. ;;;
  489. ;;; Kanji henkan
  490. ;;;
  491.  
  492. (defvar egg:*kanji-kanabuff* nil)
  493.  
  494. (defvar *bunsetu-number* nil)
  495.  
  496. (defun bunsetu-su ()
  497.   (sj3-bunsetu-suu))
  498.  
  499. (defun bunsetu-length (number)
  500.   (sj3-bunsetu-yomi-moji-suu number))
  501.  
  502. ;; #### This looks like a stupid multi-byte kludge.
  503. (defun kanji-moji-suu (str)
  504.   "Do Not Call This."
  505.   (length str))
  506.  
  507. (defun bunsetu-position (number)
  508.   (let ((pos egg:*region-start*)
  509.     (i 0))
  510.     (while (< i number)
  511.       (setq pos
  512.         (+ pos
  513.            (or (bunsetu-kanji-length  i) 0)
  514.            (length egg:*bunsetu-kugiri*)))
  515.       (incf i))
  516.     pos))
  517.  
  518. (defun bunsetu-kanji-length (bunsetu-no)
  519.   (sj3-bunsetu-kanji-length bunsetu-no))
  520.  
  521. (defun bunsetu-kanji (number)
  522.   (sj3-bunsetu-kanji number))
  523.  
  524. (defun bunsetu-kanji-insert (bunsetu-no)
  525.   (sj3-bunsetu-kanji bunsetu-no (current-buffer)))
  526.  
  527. (defun bunsetu-set-kanji (bunsetu-no kouho-no) 
  528.   (sj3-server-henkan-kakutei bunsetu-no kouho-no))
  529.  
  530. (defun bunsetu-yomi  (number) 
  531.   (sj3-bunsetu-yomi number))
  532.  
  533. (defun bunsetu-yomi-insert (bunsetu-no)
  534.   (sj3-bunsetu-yomi bunsetu-no (current-buffer)))
  535.  
  536. (defun bunsetu-yomi-equal (number yomi)
  537.   (sj3-bunsetu-yomi-equal number yomi))
  538.  
  539. (defun bunsetu-kouho-suu (bunsetu-no)
  540.   (let ((no (sj3-bunsetu-kouho-suu bunsetu-no)))
  541.     (if (< 1 no) no
  542.       (KKCP:henkan-next bunsetu-no)
  543.       (sj3-bunsetu-kouho-suu bunsetu-no))))
  544.  
  545. (defun bunsetu-kouho-list (number) 
  546.   (let ((no (bunsetu-kouho-suu number)))
  547.     (if (= no 1)
  548.     (KKCP:henkan-next number))
  549.     (sj3-bunsetu-kouho-list number)))
  550.  
  551. (defun bunsetu-kouho-number (bunsetu-no)
  552.   (sj3-bunsetu-kouho-number bunsetu-no))
  553.  
  554. ;;;;
  555. ;;;; User entry : henkan-region, henkan-paragraph, henkan-sentence
  556. ;;;;
  557.  
  558. (defconst egg:*bunsetu-face* nil "*$BJ8@aI=<($KMQ$$$k(B face $B$^$?$O(B nil")
  559. (make-variable-buffer-local
  560.  (defvar egg:*bunsetu-extent* nil "$BJ8@a$NI=<($K;H$&(B extent"))
  561.  
  562. (defconst egg:*bunsetu-kugiri* " " "*$BJ8@a$N6h@Z$j$r<($9J8;zNs(B")
  563.  
  564.  
  565. (defconst egg:*henkan-face* nil "*$BJQ49NN0h$rI=<($9$k(B face $B$^$?$O(B nil")
  566. (make-variable-buffer-local
  567.  (defvar egg:*henkan-extent* nil "$BJQ49NN0h$NI=<($K;H$&(B extent"))
  568.  
  569. (defconst egg:*henkan-open*  "|" "*$BJQ49$N;OE@$r<($9J8;zNs(B")
  570. (defconst egg:*henkan-close* "|" "*$BJQ49$N=*E@$r<($9J8;zNs(B")
  571. (defvar egg:henkan-mode-in-use nil)
  572.  
  573. (defun egg:henkan-face-on ()
  574.   (when egg:*henkan-face*
  575.     (if (extentp egg:*henkan-extent*)
  576.     (set-extent-endpoints egg:*henkan-extent*
  577.                   egg:*region-start* egg:*region-end*)
  578.       (setq egg:*henkan-extent*
  579.         (make-extent egg:*region-start* egg:*region-end*))
  580.       (mapcar
  581.        (lambda (prop)
  582.      (set-extent-property egg:*henkan-extent* prop nil))
  583.        '(start-open end-open detachable)))
  584.     (set-extent-face egg:*henkan-extent* egg:*henkan-face*)))
  585.  
  586. (defun egg:henkan-face-off ()
  587.   ;; detach henkan extent from the current buffer.
  588.   (and egg:*henkan-face*
  589.        (extentp egg:*henkan-extent*)
  590.        (detach-extent egg:*henkan-extent*)))
  591.  
  592. (defun henkan-region (start end)
  593.   (interactive "r")
  594.   (if (interactive-p) (set-mark (point))) ;;; to be fixed
  595.   (henkan-region-internal start end))
  596.  
  597. (defvar henkan-mode-indicator "$B4A(B")
  598.  
  599. (defun henkan-region-internal (start end)
  600.   "region$B$r$+$J4A;zJQ49$9$k!#(B"
  601.   (or egg:henkan-mode-in-use
  602.       (let ((finished nil))
  603.     (unwind-protect
  604.         (progn
  605.           (setq egg:henkan-mode-in-use t
  606.             egg:*kanji-kanabuff* (buffer-substring start end))
  607.           (setq *bunsetu-number* 0)
  608.           (let ((result (KKCP:henkan-begin egg:*kanji-kanabuff*)))
  609.         (when result
  610.           (mode-line-egg-mode-update henkan-mode-indicator)
  611.           (goto-char start)
  612.           (or (markerp egg:*region-start*)
  613.               (setq egg:*region-start* (make-marker)))
  614.           (or (markerp egg:*region-end*)
  615.               (setq egg:*region-end*
  616.                 (set-marker-insertion-type (make-marker) t)))
  617.           (if (null (marker-position egg:*region-start*))
  618.               (progn
  619.                       ;;;(setq egg:*global-map-backup* (current-global-map))
  620.             (setq egg:*local-map-backup* (current-local-map))
  621.             ;; XEmacs change:
  622.             (buffer-disable-undo (current-buffer))
  623.             (goto-char start)
  624.             (delete-region start end)
  625.             (insert egg:*henkan-open*)
  626.             (set-marker egg:*region-start* (point))
  627.             (insert egg:*henkan-close*)
  628.             (set-marker egg:*region-end* egg:*region-start*)
  629.             (goto-char egg:*region-start*)
  630.             )
  631.             (egg:fence-face-off)
  632.             (delete-region
  633.              (- egg:*region-start* (length egg:*fence-open*))
  634.              egg:*region-start*)
  635.             (delete-region
  636.              egg:*region-end*
  637.              (+ egg:*region-end* (length egg:*fence-close*)))
  638.             (goto-char egg:*region-start*)
  639.             (insert egg:*henkan-open*)
  640.             (set-marker egg:*region-start* (point))
  641.             (goto-char egg:*region-end*)
  642.             (let ((point (point)))
  643.               (insert egg:*henkan-close*)
  644.               (set-marker egg:*region-end* point))
  645.             (goto-char start)
  646.             (delete-region start end)
  647.             (henkan-insert-kouho 0)
  648.             (egg:henkan-face-on)
  649.             (egg:bunsetu-face-on *bunsetu-number*)
  650.             (henkan-goto-bunsetu 0)
  651.             ;;(use-global-map henkan-mode-map)
  652.             ;;(use-local-map nil)
  653.             (use-local-map henkan-mode-map)))
  654.         (setq finished t))
  655.           (or finished
  656.           (setq egg:henkan-mode-in-use nil)))))))
  657.  
  658.  
  659. (defun henkan-paragraph ()
  660.   "Kana-kanji henkan  paragraph at or after point."
  661.   (interactive )
  662.   (save-excursion
  663.     (forward-paragraph)
  664.     (let ((end (point)))
  665.       (backward-paragraph)
  666.       (henkan-region-internal (point) end ))))
  667.  
  668. (defun henkan-sentence ()
  669.   "Kana-kanji henkan sentence at or after point."
  670.   (interactive )
  671.   (save-excursion
  672.     (forward-sentence)
  673.     (let ((end (point)))
  674.       (backward-sentence)
  675.       (henkan-region-internal (point) end ))))
  676.  
  677. (defun henkan-word ()
  678.   "Kana-kanji henkan word at or after point."
  679.   (interactive)
  680.   (save-excursion
  681.     (re-search-backward "\\b\\w" nil t)
  682.     (let ((start (point)))
  683.       (re-search-forward "\\w\\b" nil t)
  684.       (henkan-region-internal start (point)))))
  685.  
  686. ;;;
  687. ;;; Kana Kanji Henkan Henshuu mode
  688. ;;;
  689.  
  690. (defun set-egg-henkan-mode-format (open close kugiri &optional henkan-face bunsetu-face)
  691.    "$BJQ49(B mode $B$NI=<(J}K!$r@_Dj$9$k!#(BOPEN $B$OJQ49$N;OE@$r<($9J8;zNs$^$?$O(B nil$B!#(B
  692. CLOSE$B$OJQ49$N=*E@$r<($9J8;zNs$^$?$O(B nil$B!#(B
  693. KUGIRI$B$OJ8@a$N6h@Z$j$rI=<($9$kJ8;zNs$^$?$O(B nil$B!#(B
  694. HENKAN-FACE $B$,;XDj$5$l$F(B nil $B$G$J$1$l$P!"JQ496h4V$rI=<($9$k(B face $B$H$7$F;H$o$l$k!#(B
  695. BUNSETU-FACE $B$,;XDj$5$l$F(B nil $B$G$J$1$l$P!"CmL\$7$F$$$kJ8@a$rI=<($9$k(B face $B$H$7$F;H$o$l$k(B"
  696.  
  697.   (interactive (list (read-string "$BJQ493+;OJ8;zNs(B: ")
  698.              (read-string "$BJQ49=*N;J8;zNs(B: ")
  699.              (read-string "$BJ8@a6h@Z$jJ8;zNs(B: ")
  700.              (cdr (assoc (completing-read "$BJQ496h4VI=<(B0@-(B: " egg:*face-alist*)
  701.                  egg:*face-alist*))
  702.              (cdr (assoc (completing-read "$BJ8@a6h4VI=<(B0@-(B: " egg:*face-alist*)
  703.                  egg:*face-alist*))
  704.              ))
  705.  
  706.   (if (and (or (stringp open)  (null open))
  707.        (or (stringp close) (null close))
  708.        (or (stringp kugiri) (null kugiri))
  709.        (or (null henkan-face) (memq henkan-face (face-list)))
  710.        (or (null bunsetu-face) (memq henkan-face (face-list))))
  711.       (progn
  712.     (setq egg:*henkan-open* (or open "")
  713.           egg:*henkan-close* (or close "")
  714.           egg:*bunsetu-kugiri* (or kugiri "")
  715.           egg:*henkan-face* henkan-face
  716.           egg:*bunsetu-face* bunsetu-face)
  717.     (and (extentp egg:*henkan-extent*)
  718.          (set-extent-property
  719.           egg:*henkan-extent* 'face egg:*henkan-face*))
  720.     (and (extentp egg:*bunsetu-extent*)
  721.          (set-extent-property
  722.           egg:*bunsetu-extent* 'face egg:*bunsetu-face*))
  723.  
  724.     t)
  725.     (error "Wrong type of arguments: %1 %2 %3 %4 %5" open close kugiri henkan-face bunsetu-face)))
  726.  
  727. (defun henkan-insert-kouho (bunsetu-no)
  728.   (let ((max (bunsetu-su)) (i bunsetu-no))
  729.     (while (< i max)
  730.       (bunsetu-kanji-insert i) 
  731.       (insert  egg:*bunsetu-kugiri* )
  732.       (setq i (1+ i)))
  733.     (if (< bunsetu-no max) (delete-char (- (length egg:*bunsetu-kugiri*))))))
  734.  
  735. (defun henkan-kakutei ()
  736.   (interactive)
  737.   (egg:bunsetu-face-off)
  738.   (egg:henkan-face-off)
  739.   (delete-region (- egg:*region-start* (length egg:*henkan-open*))
  740.          egg:*region-start*)
  741.   (delete-region egg:*region-start* egg:*region-end*)
  742.   (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*henkan-close*)))
  743.   (goto-char egg:*region-start*)
  744.   (let ((i 0) (max (bunsetu-su)))
  745.     (while (< i max)
  746.       ;;;(KKCP:henkan-kakutei i (bunsetu-kouho-number i))
  747.       (bunsetu-kanji-insert i)
  748.       (if (not overwrite-mode)
  749.       (undo-boundary))
  750.       (setq i (1+ i))
  751.       ))
  752.   (KKCP:henkan-end)
  753.   (setq egg:henkan-mode-in-use nil)
  754.   (egg:quit-egg-mode)
  755.   )
  756.  
  757. (defun henkan-kakutei-before-point ()
  758.   (interactive)
  759.   (egg:bunsetu-face-off)
  760.   (egg:henkan-face-off)
  761.   (delete-region egg:*region-start* egg:*region-end*)
  762.   (goto-char egg:*region-start*)
  763.   (let ((i 0) (max *bunsetu-number*))
  764.     (while (< i max)
  765.       ;;;(KKCP:henkan-kakutei i (bunsetu-kouho-number i))
  766.       (bunsetu-kanji-insert i)
  767.       (if (not overwrite-mode)
  768.       (undo-boundary))
  769.       (setq i (1+ i))
  770.       ))
  771.   (KKCP:henkan-end *bunsetu-number*)
  772.   (delete-region (- egg:*region-start* (length egg:*henkan-open*))
  773.          egg:*region-start*)
  774.   (insert egg:*fence-open*)
  775.   (set-marker egg:*region-start* (point))
  776.   (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*henkan-close*)))
  777.   (goto-char egg:*region-end*)
  778.   (let ((point (point)))
  779.     (insert egg:*fence-close*)
  780.     (set-marker egg:*region-end* point))
  781.   (goto-char egg:*region-start*)
  782.   (egg:fence-face-on)
  783.   (let ((point (point))
  784.     (i *bunsetu-number*) (max (bunsetu-su)))
  785.     (while (< i max)
  786.       (bunsetu-yomi-insert i)
  787.       (setq i (1+ i)))
  788.     ;;;(insert "|")
  789.     ;;;(insert egg:*fence-close*)
  790.     ;;;(set-marker egg:*region-end* (point))
  791.     (goto-char point))
  792.   (setq egg:*mode-on* t)
  793.   ;;;(use-global-map fence-mode-map)
  794.   ;;;(use-local-map  nil)
  795.   (setq egg:henkan-mode-in-use nil)
  796.   (use-local-map fence-mode-map)
  797.   (egg:mode-line-display))
  798.  
  799. (defun egg:set-bunsetu-face (no face switch)
  800.   (if (not switch)
  801.       (egg:bunsetu-face-off) ;; JIC
  802.     (unless (extentp egg:*bunsetu-extent*)
  803.       (setq egg:*bunsetu-extent* (make-extent 1 1 nil))
  804.       (set-extent-property egg:*bunsetu-extent* 'face egg:*bunsetu-face*))
  805.     (set-extent-endpoints egg:*bunsetu-extent*
  806.               (if (eq face 'modeline)
  807.                   (let ((point (bunsetu-position no)))
  808.                 (1+ point))
  809.                 (bunsetu-position no))
  810.  
  811.               (if (= no (1- (bunsetu-su)))
  812.                   egg:*region-end*
  813.                 (- (bunsetu-position (1+ no))
  814.                    (length egg:*bunsetu-kugiri*)))
  815.               (current-buffer))))
  816.  
  817. (defun egg:bunsetu-face-on (no)
  818.   (egg:set-bunsetu-face no egg:*bunsetu-face* t))
  819.  
  820. (defun egg:bunsetu-face-off ()
  821.   ;; detach henkan extent from the current buffer.
  822.   (and (extentp egg:*bunsetu-extent*)
  823.        (detach-extent egg:*bunsetu-extent*)))
  824.  
  825. (defun henkan-goto-bunsetu (number)
  826.   (setq *bunsetu-number*
  827.     (check-number-range number 0 (1- (bunsetu-su))))
  828.   (goto-char (bunsetu-position *bunsetu-number*))
  829.   (egg:bunsetu-face-on *bunsetu-number*)
  830.   )
  831.  
  832. (defun henkan-forward-bunsetu ()
  833.   (interactive)
  834.   (henkan-goto-bunsetu (1+ *bunsetu-number*))
  835.   )
  836.  
  837. (defun henkan-backward-bunsetu ()
  838.   (interactive)
  839.   (henkan-goto-bunsetu (1- *bunsetu-number*))
  840.   )
  841.  
  842. (defun henkan-first-bunsetu ()
  843.   (interactive)
  844.   (henkan-goto-bunsetu 0))
  845.  
  846. (defun henkan-last-bunsetu ()
  847.   (interactive)
  848.   (henkan-goto-bunsetu (1- (bunsetu-su)))
  849.   )
  850.  
  851. (defun check-number-range (i min max)
  852.   (cond((< i min) max)
  853.        ((< max i) min)
  854.        (t i)))
  855.  
  856. (defun henkan-hiragana ()
  857.   (interactive)
  858.   (henkan-goto-kouho (- (bunsetu-kouho-suu *bunsetu-number*) 1)))
  859.  
  860. (defun henkan-katakana ()
  861.   (interactive)
  862.   (henkan-goto-kouho (- (bunsetu-kouho-suu *bunsetu-number*) 2)))
  863.  
  864. (defun henkan-next-kouho ()
  865.   (interactive)
  866.   (henkan-goto-kouho (1+ (bunsetu-kouho-number *bunsetu-number*))))
  867.  
  868. (defun henkan-previous-kouho ()
  869.   (interactive)
  870.   (henkan-goto-kouho (1- (bunsetu-kouho-number *bunsetu-number*))))
  871.  
  872. (defun henkan-goto-kouho (kouho-number)
  873.   (let ((point (point))
  874.     (yomi  (bunsetu-yomi *bunsetu-number*))
  875.     (i *bunsetu-number*)
  876.     (max (bunsetu-su)))
  877.     (setq kouho-number 
  878.       (check-number-range kouho-number 
  879.                   0
  880.                   (1- (bunsetu-kouho-suu *bunsetu-number*))))
  881.     (while (< i max)
  882.       (if (bunsetu-yomi-equal i yomi)
  883.       (let ((p1 (bunsetu-position i)))
  884.         (delete-region p1
  885.                (+ p1 (bunsetu-kanji-length i)))
  886.         (goto-char p1)
  887.         (bunsetu-set-kanji i kouho-number)
  888.         (bunsetu-kanji-insert i)))
  889.       (setq i (1+ i)))
  890.     (goto-char point))
  891.   (egg:bunsetu-face-on *bunsetu-number*))
  892.  
  893. (defun henkan-bunsetu-chijime ()
  894.   (interactive)
  895.   (or (= (bunsetu-length *bunsetu-number*) 1)
  896.       (bunsetu-length-henko (1-  (bunsetu-length *bunsetu-number*)))))
  897.  
  898. (defun henkan-bunsetu-nobasi ()
  899.   (interactive)
  900.   (if (not (= (1+ *bunsetu-number*) (bunsetu-su)))
  901.       (bunsetu-length-henko (1+ (bunsetu-length *bunsetu-number*)))))
  902.  
  903. (defun henkan-saishou-bunsetu ()
  904.   (interactive)
  905.   (bunsetu-length-henko 1))
  906.  
  907. (defun henkan-saichou-bunsetu ()
  908.   (interactive)
  909.   (let ((max (bunsetu-su)) (i *bunsetu-number*)
  910.     (l 0))
  911.     (while (< i max)
  912.       (setq l (+ l (bunsetu-length i)))
  913.       (setq i (1+ i)))
  914.     (bunsetu-length-henko l)))
  915.  
  916. (defun bunsetu-length-henko (length)
  917.   (let ((r (KKCP:bunsetu-henkou *bunsetu-number* length)))
  918.     (cond(r
  919.       (delete-region 
  920.        (bunsetu-position *bunsetu-number*) egg:*region-end*)
  921.       (goto-char (bunsetu-position *bunsetu-number*))
  922.       (henkan-insert-kouho *bunsetu-number*)
  923.       (henkan-goto-bunsetu *bunsetu-number*))
  924.      (t
  925.       (egg:bunsetu-face-on *bunsetu-number*)))))
  926.  
  927. (defun henkan-quit ()
  928.   (interactive)
  929.   (egg:bunsetu-face-off)
  930.   (egg:henkan-face-off)
  931.   (delete-region (- egg:*region-start* (length egg:*henkan-open*))
  932.          egg:*region-start*)
  933.   (delete-region egg:*region-start* egg:*region-end*)
  934.   (delete-region egg:*region-end* (+ egg:*region-end* (length egg:*henkan-close*)))
  935.   (goto-char egg:*region-start*)
  936.   (insert egg:*fence-open*)
  937.   (set-marker egg:*region-start* (point))
  938.   (insert egg:*kanji-kanabuff*)
  939.   (let ((point (point)))
  940.     (insert egg:*fence-close*)
  941.     (set-marker egg:*region-end* point)
  942.     )
  943.   (goto-char egg:*region-end*)
  944.   (egg:fence-face-on)
  945.   (KKCP:henkan-quit)
  946.   (setq egg:*mode-on* t)
  947.   ;;;(use-global-map fence-mode-map)
  948.   ;;;(use-local-map  nil)
  949.   (setq egg:henkan-mode-in-use nil)
  950.   (use-local-map fence-mode-map)
  951.   (egg:mode-line-display)
  952.   )
  953.  
  954. (defun henkan-select-kouho ()
  955.   (interactive)
  956.   (if (not (eq (selected-window) (minibuffer-window)))
  957.       (let ((kouho-list (bunsetu-kouho-list *bunsetu-number*))
  958.         menu)
  959.     (setq menu
  960.           (list 'menu "$B<!8uJd(B:"
  961.             (let ((l kouho-list) (r nil) (i 0))
  962.               (while l
  963.             (setq r (cons (cons (car l) i) r))
  964.             (setq i (1+ i))
  965.             (setq l (cdr l)))
  966.               (reverse r))))
  967.     (henkan-goto-kouho 
  968.      (menu:select-from-menu menu 
  969.                    (bunsetu-kouho-number *bunsetu-number*))))
  970.     (beep)))
  971.  
  972. (defun henkan-kakutei-and-self-insert ()
  973.   (interactive)
  974.   (setq unread-command-events (list last-command-event))
  975.   (henkan-kakutei))
  976.  
  977.  
  978. (defvar henkan-mode-map (make-keymap))
  979.  
  980. (defvar henkan-mode-esc-map (make-keymap))
  981.  
  982. (let ((ch 0))
  983.   (while (<= ch 127)
  984.     (unless (eq ch 27)
  985.       (define-key henkan-mode-map (make-string 1 ch) 'undefined))
  986.     (define-key henkan-mode-esc-map (make-string 1 ch) 'undefined)
  987.     (setq ch (1+ ch))))
  988.  
  989. (let ((ch 32))
  990.   (while (< ch 127)
  991.     (define-key henkan-mode-map (make-string 1 ch) 'henkan-kakutei-and-self-insert)
  992.     (setq ch (1+ ch))))
  993.  
  994. (condition-case ()
  995.     (define-key henkan-mode-map "\e"    henkan-mode-esc-map)
  996.   (error nil))
  997. (define-key henkan-mode-map "\ei"  'undefined) ;; henkan-inspect-bunsetu
  998.                            ;; not support for sj3
  999. (define-key henkan-mode-map "\es"  'henkan-select-kouho)
  1000. (define-key henkan-mode-map "\eh"  'henkan-hiragana)
  1001. (define-key henkan-mode-map "\ek"  'henkan-katakana)
  1002. (define-key henkan-mode-map "\e<"  'henkan-saishou-bunsetu)
  1003. (define-key henkan-mode-map "\e>"  'henkan-saichou-bunsetu)
  1004. (define-key henkan-mode-map " "    'henkan-next-kouho)
  1005. (define-key henkan-mode-map "\C-@" 'henkan-next-kouho)
  1006. (define-key henkan-mode-map "\C-a" 'henkan-first-bunsetu)
  1007. (define-key henkan-mode-map "\C-b" 'henkan-backward-bunsetu)
  1008. (define-key henkan-mode-map "\C-c" 'henkan-quit)
  1009. (define-key henkan-mode-map "\C-d" 'undefined)
  1010. (define-key henkan-mode-map "\C-e" 'henkan-last-bunsetu)
  1011. (define-key henkan-mode-map "\C-f" 'henkan-forward-bunsetu)
  1012. (define-key henkan-mode-map "\C-g" 'henkan-quit)
  1013. (define-key henkan-mode-map "\C-h" 'help-command)
  1014. (define-key henkan-mode-map "\C-i" 'henkan-bunsetu-chijime)
  1015. (define-key henkan-mode-map "\C-j" 'undefined)
  1016. (define-key henkan-mode-map "\C-k" 'henkan-kakutei-before-point)
  1017. (define-key henkan-mode-map "\C-l" 'henkan-kakutei)
  1018. (define-key henkan-mode-map "\C-m" 'henkan-kakutei)
  1019. (define-key henkan-mode-map "\C-n" 'henkan-next-kouho)
  1020. (define-key henkan-mode-map "\C-o" 'henkan-bunsetu-nobasi)
  1021. (define-key henkan-mode-map "\C-p" 'henkan-previous-kouho)
  1022. (define-key henkan-mode-map "\C-q" 'undefined)
  1023. (define-key henkan-mode-map "\C-r" 'undefined)
  1024. (define-key henkan-mode-map "\C-s" 'undefined)
  1025. (define-key henkan-mode-map "\C-t" 'undefined)
  1026. (define-key henkan-mode-map "\C-u" 'undefined)
  1027. (define-key henkan-mode-map "\C-v" 'undefined)
  1028. (define-key henkan-mode-map "\C-w" 'undefined)
  1029. (define-key henkan-mode-map "\C-x" 'undefined)
  1030. (define-key henkan-mode-map "\C-y" 'undefined)
  1031. (define-key henkan-mode-map "\C-z" 'undefined)
  1032. (define-key henkan-mode-map "\177" 'henkan-quit)
  1033.  
  1034. (defun henkan-help-command ()
  1035.   "Display documentation fo henkan-mode."
  1036.   (interactive)
  1037.   (with-output-to-temp-buffer "*Help*"
  1038.     (princ (substitute-command-keys henkan-mode-document-string))
  1039.     (print-help-return-message)))
  1040.  
  1041. (defvar henkan-mode-document-string "$B4A;zJQ49%b!<%I(B:
  1042. $BJ8@a0\F0(B
  1043.   \\[henkan-first-bunsetu]\t$B@hF,J8@a(B\t\\[henkan-last-bunsetu]\t$B8eHxJ8@a(B  
  1044.   \\[henkan-backward-bunsetu]\t$BD>A0J8@a(B\t\\[henkan-forward-bunsetu]\t$BD>8eJ8@a(B
  1045. $BJQ49JQ99(B
  1046.   $B<!8uJd(B    \\[henkan-previous-kouho]  \t$BA08uJd(B    \\[henkan-next-kouho]
  1047.   $BJ8@a?-$7(B  \\[henkan-bunsetu-nobasi]  \t$BJ8@a=L$a(B  \\[henkan-bunsetu-chijime]
  1048.   $BJQ498uJdA*Br(B  \\[henkan-select-kouho]
  1049. $BJQ493NDj(B
  1050.   $BA4J8@a3NDj(B  \\[henkan-kakutei]  \t$BD>A0J8@a$^$G3NDj(B  \\[henkan-kakutei-before-point]
  1051. $BJQ49Cf;_(B    \\[henkan-quit]
  1052. ")
  1053.  
  1054. ;;;----------------------------------------------------------------------
  1055. ;;;
  1056. ;;; Dictionary management Facility
  1057. ;;;
  1058. ;;;----------------------------------------------------------------------
  1059.  
  1060. ;;;
  1061. ;;; $B<-=qEPO?(B 
  1062. ;;;
  1063.  
  1064. ;;;;
  1065. ;;;; User entry: toroku-region
  1066. ;;;;
  1067.  
  1068. (defun remove-regexp-in-string (regexp string)
  1069.   (cond((not(string-match regexp string))
  1070.     string)
  1071.        (t(let ((str nil)
  1072.          (ostart 0)
  1073.          (oend   (match-beginning 0))
  1074.          (nstart (match-end 0)))
  1075.      (setq str (concat str (substring string ostart oend)))
  1076.      (while (string-match regexp string nstart)
  1077.        (setq ostart nstart)
  1078.        (setq oend   (match-beginning 0))
  1079.        (setq nstart (match-end 0))
  1080.        (setq str (concat str (substring string ostart oend))))
  1081.      str))))
  1082.  
  1083. (defun toroku-region (start end)
  1084.   (interactive "r")
  1085.   (let*((kanji
  1086.      (remove-regexp-in-string "[\0-\37]" (buffer-substring start end)))
  1087.     (yomi (read-hiragana-string
  1088.            (format "$B<-=qEPO?!X(B%s$B!Y(B  $BFI$_(B :" kanji)))
  1089.     (type (menu:select-from-menu *sj3-bunpo-menu*))
  1090.     (dict-no 
  1091.      (menu:select-from-menu (list 'menu "$BEPO?<-=qL>(B:" egg:*dict-menu*))))
  1092.     ;;;(if (string-match "[\0-\177]" kanji)
  1093.     ;;;    (error "Kanji string contains hankaku character. %s" kanji))
  1094.     ;;;(if (string-match "[\0-\177]" yomi)
  1095.     ;;;    (error "Yomi string contains hankaku character. %s" yomi))
  1096.     (KKCP:dict-add dict-no kanji yomi type)
  1097.     (let ((hinshi (nth 1 (assq type *sj3-bunpo-code*)))
  1098.       (gobi   (nth 2 (assq type *sj3-bunpo-code*)))
  1099.       (dict-name (cdr (assq dict-no egg:*usr-dict*))))
  1100.       (notify "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$KEPO?$7$^$7$?!#(B"
  1101.           (if gobi (concat kanji " " gobi) kanji)
  1102.           (if gobi (concat yomi  " " gobi) yomi)
  1103.           hinshi dict-name))))
  1104.  
  1105.  
  1106.  
  1107. ;;; (lsh 1 18)
  1108. (defvar *sj3-bunpo-menu*
  1109.   '(menu "$BIJ;l(B:"
  1110.    (("$BL>;l(B"      .
  1111.      (menu "$BIJ;l(B:$BL>;l(B:"
  1112.        (("$BL>;l(B"        . 1)
  1113.         ("$BL>;l(B($B$*!D(B)"    . 2)
  1114.         ("$BL>;l(B($B$4!D(B)"    . 3)
  1115.         ("$BL>;l(B($B!DE*(B/$B2=(B)"    . 4)
  1116.         ("$BL>;l(B($B$*!D$9$k(B)"    . 5)
  1117.         ("$BL>;l(B($B!D$9$k(B)"    . 6)
  1118.         ("$BL>;l(B($B$4!D$9$k(B)"    . 7)
  1119.         ("$BL>;l(B($B!D$J(B/$B$K(B)"    . 8)
  1120.         ("$BL>;l(B($B$*!D$J(B/$B$K(B)"    . 9)
  1121.         ("$BL>;l(B($B$4!D$J(B/$B$K(B)"    . 10)
  1122.         ("$BL>;l(B($BI{;l(B)"    . 11))))
  1123.     ("$BBeL>;l(B"    . 12)
  1124.     ("$BID;z(B"      . 21)
  1125.     ("$BL>A0(B"      . 22)
  1126.     ("$BCOL>(B"      . 24)
  1127.     ("$B8)(B/$B6hL>(B"   . 25)
  1128.     ("$BF0;l(B"      .
  1129.       (menu "$BIJ;l(B:$BF0;l(B:"
  1130.         (("$B%5JQ8l44(B"      . 80)
  1131.          ("$B%6JQ8l44(B"      . 81)
  1132.          ("$B0lCJITJQ2=It(B"  . 90)
  1133.          ("$B%+9T8^CJ8l44(B"  . 91)
  1134.          ("$B%,9T8^CJ8l44(B"  . 92)   
  1135.          ("$B%59T8^CJ8l44(B"  . 93)   
  1136.          ("$B%?9T8^CJ8l44(B"  . 94)   
  1137.          ("$B%J9T8^CJ8l44(B"  . 95)   
  1138.          ("$B%P9T8^CJ8l44(B"  . 96)   
  1139.          ("$B%^9T8^CJ8l44(B"  . 97)   
  1140.          ("$B%i9T8^CJ8l44(B"  . 98)   
  1141.          ("$B%o9T8^CJ8l44(B"  . 99))))   
  1142.     ("$BO"BN;l(B"         . 26)
  1143.     ("$B@\B3;l(B"         . 27)
  1144.     ("$B=u?t;l(B"         . 29)
  1145.     ("$B?t;l(B"           . 30)
  1146.     ("$B@\F,8l(B"         . 31)
  1147.     ("$B@\Hx8l(B"         . 36)
  1148.     ("$BI{;l(B"           . 45)
  1149.     ("$BI{;l(B2"          . 46)
  1150.     ("$B7AMF;l8l44(B"     . 60)
  1151.     ("$B7AMFF0;l8l44(B"   . 71)
  1152.     ("$BC14A;z(B"         . 189))))
  1153.  
  1154. (defvar *sj3-bunpo-code*
  1155.   '(
  1156.     ( 1   "$BL>;l(B" )
  1157.     ( 2   "$BL>;l(B($B$*!D(B)" )
  1158.     ( 3   "$BL>;l(B($B$4!D(B)" )
  1159.     ( 4   "$BL>;l(B($B!DE*(B/$B2=(B)" "$BE*(B" nil)
  1160.     ( 5   "$BL>;l(B($B$*!D$9$k(B)" "$B$9$k(B" nil)
  1161.     ( 6   "$BL>;l(B($B!D$9$k(B)" "$B$9$k(B" nil)
  1162.     ( 7   "$BL>;l(B($B$4!D$9$k(B)" "$B$9$k(B" nil)
  1163.     ( 8   "$BL>;l(B($B!D$J(B/$B$K(B)" "$B$J(B/$B$K(B" nil)
  1164.     ( 9   "$BL>;l(B($B$*!D$J(B/$B$K(B)" "$B$J(B/$B$K(B" nil)
  1165.     ( 10  "$BL>;l(B($B$4!D$J(B/$B$K(B)" "$B$J(B/$B$K(B" nil)
  1166.     ( 11  "$BL>;l(B($BI{;l(B)" )
  1167.     ( 12  "$BBeL>;l(B" )
  1168.     ( 21  "$BID;z(B" )
  1169.     ( 22  "$BL>A0(B" )
  1170.     ( 24  "$BCOL>(B" )
  1171.     ( 25  "$B8)(B/$B6hL>(B" )
  1172.     ( 26  "$BO"BN;l(B" )
  1173.     ( 27  "$B@\B3;l(B" )
  1174.     ( 29  "$B=u?t;l(B" )
  1175.     ( 30  "$B?t;l(B"   )
  1176.     ( 31  "$B@\F,8l(B" )
  1177.     ( 36  "$B@\Hx8l(B" )
  1178.     ( 45  "$BI{;l(B" )
  1179.     ( 46  "$BI{;l(B2" )
  1180.     ( 60  "$B7AMF;l8l44(B"           "$B$$(B" ("" "" "" "" ""))
  1181.     ( 71  "$B7AMFF0;l8l44(B"         "$B$K(B" ("" "" "" "" "") )
  1182.     ( 80  "$B%5JQ8l44(B"             "$B$9$k(B" ("" "" "" "" ""))
  1183.     ( 81  "$B%6JQ8l44(B"             "$B$:$k(B" ("" "" "" "" ""))
  1184.     ( 90  "$B0lCJITJQ2=It(B"         "$B$k(B" ("" "" "" "" ""))
  1185.     ( 91  "$B%+9T8^CJ8l44(B"         "$B$/(B" ("$B$+$J$$(B" "$B$-$^$9(B" "$B$/(B" "$B$/$H$-(B" "$B$1(B"))
  1186.     ( 92  "$B%,9T8^CJ8l44(B"         "$B$0(B" ("$B$,$J$$(B" "$B$.$^$9(B" "" "" ""))
  1187.     ( 93  "$B%59T8^CJ8l44(B"         "$B$9(B" ("" "" "" "" ""))
  1188.     ( 94  "$B%?9T8^CJ8l44(B"         "$B$D(B" ("" "" "" "" ""))
  1189.     ( 95  "$B%J9T8^CJ8l44(B"         "$B$L(B" ("" "" "" "" ""))   
  1190.     ( 96  "$B%P9T8^CJ8l44(B"         "$B$V(B" ("" "" "" "" ""))   
  1191.     ( 97  "$B%^9T8^CJ8l44(B"         "$B$`(B" ("" "" "" "" ""))   
  1192.     ( 98  "$B%i9T8^CJ8l44(B"         "$B$k(B" ("" "" "" "" ""))   
  1193.     ( 99  "$B%o9T8^CJ8l44(B"         "$B$&(B" ("" "" "" "" ""))   
  1194.     ( 189  "$BC14A;z(B"  )
  1195.     ( 190  "$BITDj(B"  )
  1196.     ( 1000  "$B$=$NB>(B"  )
  1197.     ))
  1198.  
  1199. ;;;
  1200. ;;; $B<-=qJT=87O(B DicEd
  1201. ;;;
  1202.  
  1203. (defvar *diced-window-configuration* nil)
  1204.  
  1205. (defvar *diced-dict-info* nil)
  1206.  
  1207. (defvar *diced-dno* nil)
  1208.  
  1209. ;;;;;
  1210. ;;;;; User entry : edit-dict
  1211. ;;;;;
  1212.  
  1213. (defun edit-dict ()
  1214.   (interactive)
  1215.   (let*((dict-no 
  1216.      (menu:select-from-menu (list 'menu "$B<-=qL>(B:" egg:*dict-menu*)))
  1217.     (dict-name (file-name-nondirectory 
  1218.             (cdr (assq dict-no egg:*usr-dict*))))
  1219.     (dict-info (KKCP:dict-info dict-no)))
  1220.     (if (null dict-info)
  1221.     (message "$B<-=q(B: %s $B$KEPO?$5$l$F$$$k9`L\$O$"$j$^$;$s!#(B" dict-name)
  1222.       (progn
  1223.     (setq *diced-dno* dict-no)
  1224.     (setq *diced-window-configuration* (current-window-configuration))
  1225.     (pop-to-buffer "*Nihongo Dictionary Information*")
  1226.     (setq major-mode 'diced-mode)
  1227.     (setq mode-name "Diced")
  1228.     (setq mode-line-buffer-identification 
  1229.           (concat "DictEd: " dict-name
  1230.               (make-string  
  1231.                (max 0 (- 17 (string-width dict-name))) ?  )
  1232.               ))
  1233.     (sit-for 0) ;; will redislay.
  1234.     ;;;(use-global-map diced-mode-map)
  1235.     (use-local-map diced-mode-map)
  1236.     (diced-display dict-info)
  1237.     ))))
  1238.  
  1239. (defun diced-redisplay ()
  1240.   (let ((dict-info (KKCP:dict-info *diced-dno*)))
  1241.     (if (null dict-info)
  1242.     (progn
  1243.       (message "$B<-=q(B: %s $B$KEPO?$5$l$F$$$k9`L\$O$"$j$^$;$s!#(B"
  1244.            (file-name-nondirectory 
  1245.             (cdr (assq *diced-dno* egg:*usr-dict*))))
  1246.       (diced-quit))
  1247.       (diced-display dict-info))))
  1248.  
  1249. (defun diced-display (dict-info)
  1250.     ;;; (values (list (record yomi kanji bunpo)))
  1251.     ;;;                         0    1     2
  1252.   (setq *diced-dict-info* dict-info)
  1253.   (setq buffer-read-only nil)
  1254.   (erase-buffer)
  1255.   (let ((l-yomi
  1256.      (apply 'max
  1257.         (mapcar (function (lambda (l) (string-width (nth 0 l))))
  1258.             dict-info)))
  1259.     (l-kanji 
  1260.      (apply 'max
  1261.         (mapcar (function (lambda (l) (string-width (nth 1 l))))
  1262.             dict-info))))
  1263.     (while dict-info
  1264.       (let*((yomi (nth 0 (car dict-info)))
  1265.         (kanji (nth 1 (car dict-info)))
  1266.         (bunpo (nth 2 (car dict-info)))
  1267.         (gobi   (nth 2 (assq bunpo *sj3-bunpo-code*)))
  1268.         (hinshi (nth 1 (assq bunpo *sj3-bunpo-code*))))
  1269.  
  1270.     (insert "  " yomi)
  1271.     (if gobi (insert " " gobi))
  1272.     (insert-char ?  
  1273.              (- (+ l-yomi 10) (string-width yomi)
  1274.             (if gobi (+ 1 (string-width gobi)) 0)))
  1275.     (insert kanji)
  1276.     (if gobi (insert " " gobi))
  1277.     (insert-char ?  
  1278.              (- (+ l-kanji 10) (string-width kanji)
  1279.             (if gobi (+ 1 (string-width gobi)) 0)))
  1280.     (insert hinshi ?\n)
  1281.     (setq dict-info (cdr dict-info))))
  1282.     (goto-char (point-min)))
  1283.   (setq buffer-read-only t))
  1284.  
  1285. (defun diced-add ()
  1286.   (interactive)
  1287.   (diced-execute t)
  1288.   (let*((kanji (read-kanji-string "$B4A;z!'(B"))
  1289.     (yomi (read-hiragana-string "$BFI$_!'(B"))
  1290.     (bunpo (menu:select-from-menu *sj3-bunpo-menu*))
  1291.     (gobi   (nth 2 (assq bunpo *sj3-bunpo-code*)))
  1292.     (hinshi (nth 1 (assq bunpo *sj3-bunpo-code*)))
  1293.     (item (if gobi (concat kanji " " gobi) kanji))
  1294.     (item-yomi (if gobi (concat yomi " " gobi) yomi))
  1295.     (dict-name (cdr (assq *diced-dno* egg:*usr-dict*))))
  1296.     (if (notify-yes-or-no-p "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$KEPO?$7$^$9!#(B" 
  1297.           item item-yomi hinshi (file-name-nondirectory dict-name))
  1298.     (progn
  1299.       (KKCP:dict-add *diced-dno* kanji yomi bunpo)
  1300.       (notify "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$KEPO?$7$^$7$?!#(B" 
  1301.           item item-yomi hinshi dict-name)
  1302.       (diced-redisplay)))))
  1303.  
  1304. (defun diced-delete ()
  1305.   (interactive)
  1306.   (beginning-of-line)
  1307.   (if (eq (char-after) ?  )
  1308.       (let ((buffer-read-only nil))
  1309.     (delete-char 1) (insert "D") (backward-char 1))))
  1310.  
  1311. (defun diced-undelete ()
  1312.   (interactive)
  1313.   (beginning-of-line)
  1314.   (if (eq (char-after) ?D)
  1315.       (let ((buffer-read-only nil))
  1316.     (delete-char 1) (insert " ") (backward-char 1))
  1317.     (beep)))
  1318.  
  1319. (defun diced-quit ()
  1320.   (interactive)
  1321.   (setq buffer-read-only nil)
  1322.   (erase-buffer)
  1323.   (setq buffer-read-only t)
  1324.   (bury-buffer (get-buffer "*Nihongo Dictionary Information*"))
  1325.   (set-window-configuration *diced-window-configuration*)
  1326.   )
  1327.  
  1328. (defun diced-execute (&optional display)
  1329.   (interactive)
  1330.   (goto-char (point-min))
  1331.   (let ((no  0))
  1332.     (while (not (eobp))
  1333.       (if (eq (char-after) ?D)
  1334.       (let* ((dict-item (nth no *diced-dict-info*))
  1335.          (yomi (nth 0 dict-item))
  1336.          (kanji (nth 1 dict-item))
  1337.          (bunpo (nth 2 dict-item))
  1338.          (gobi   (nth 2 (assq bunpo *sj3-bunpo-code*)))
  1339.          (hinshi (nth 1 (assq bunpo *sj3-bunpo-code*)))
  1340.          (dict-name (cdr (assq *diced-dno* egg:*usr-dict*)))
  1341.          (item (if gobi (concat kanji " " gobi) kanji))
  1342.          (item-yomi (if gobi (concat yomi " " gobi) yomi)))
  1343.         (if (notify-yes-or-no-p "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$+$i:o=|$7$^$9!#(B"
  1344.                 item item-yomi hinshi (file-name-nondirectory 
  1345.                                dict-name))
  1346.         (progn
  1347.           (KKCP:dict-delete *diced-dno* kanji yomi bunpo)
  1348.           (notify "$B<-=q9`L\!X(B%s$B!Y(B(%s: %s)$B$r(B%s$B$+$i:o=|$7$^$7$?!#(B"
  1349.               item item-yomi hinshi dict-name)
  1350.           ))))
  1351.       (setq no (1+ no))
  1352.       (forward-line 1)))
  1353.   (forward-line -1)
  1354.   (if (not display) (diced-redisplay)))
  1355.  
  1356. (defun diced-next-line ()
  1357.   (interactive)
  1358.   (beginning-of-line)
  1359.   (forward-line 1)
  1360.   (if (eobp) (progn (beep) (forward-line -1))))
  1361.  
  1362. (defun diced-end-of-buffer ()
  1363.   (interactive)
  1364.   (end-of-buffer)
  1365.   (forward-line -1))
  1366.  
  1367. (defun diced-scroll-down ()
  1368.   (interactive)
  1369.   (scroll-down)
  1370.   (if (eobp) (forward-line -1)))
  1371.  
  1372. (defun diced-mode ()
  1373.   "Mode for \"editing\" dictionaries.
  1374. In diced, you are \"editing\" a list of the entries in dictionaries.
  1375. You can move using the usual cursor motion commands.
  1376. Letters no longer insert themselves. Instead, 
  1377.  
  1378. Type  a to Add new entry.
  1379. Type  d to flag an entry for Deletion.
  1380. Type  n to move cursor to Next entry.
  1381. Type  p to move cursor to Previous entry.
  1382. Type  q to Quit from DicEd.
  1383. Type  u to Unflag an entry (remove its D flag).
  1384. Type  x to eXecute the deletions requested.
  1385. "
  1386.  )
  1387.  
  1388. (defvar diced-mode-map (let ((map (make-keymap))) (suppress-keymap map) map))
  1389.  
  1390. (define-key diced-mode-map "a"    'diced-add)
  1391. (define-key diced-mode-map "d"    'diced-delete)
  1392. (define-key diced-mode-map "n"    'diced-next-line)
  1393. (define-key diced-mode-map "p"    'previous-line)
  1394. (define-key diced-mode-map "q"    'diced-quit)
  1395. (define-key diced-mode-map "u"    'diced-undelete)
  1396. (define-key diced-mode-map "x"    'diced-execute)
  1397.  
  1398. (define-key diced-mode-map "\C-h" 'help-command)
  1399. (define-key diced-mode-map "\C-n" 'diced-next-line)
  1400. (define-key diced-mode-map "\C-p" 'previous-line)
  1401. (define-key diced-mode-map "\C-v" 'scroll-up)
  1402. (define-key diced-mode-map "\e<"  'beginning-of-buffer)
  1403. (define-key diced-mode-map "\e>"  'diced-end-of-buffer)
  1404. (define-key diced-mode-map "\ev"  'diced-scroll-down)
  1405.  
  1406. ;;; egg-sj3.el ends here
  1407.